Belgian Amiga Club - ADF Collection/BS1 part 27.zip/BS1 part 27/ImageMaster_d3.adf/piarc.lzh.parta/nbkr.rexx

OS/2 REXX Batch file | 1993-03-23 | 5KB | 213 lines

/*
 * nbkr.rexx
 *
 *  Written by: Pete Patterson & Ben Williams
 * Last Update: March 17, 1992
 *         For: Black Belt Systems image processing series IM, IM F/c, and IP.
 * ---------------------------------------------------------------------------
 *    Revision: 1.02
 */
parse arg fullname
call pragma('stack',20000);

/*
 * open rexxsupport.library -- needed for some functions
 */
if ~show('L',"rexxsupport.library") then do
  if addlib('rexxsupport.library',0,-30,0) then do
      /* everything's ok */
    end;
  else do
    say 'We Have A Library Problem, Unable To Load "rexxsupport.library"';
    say 'Cannot operate nbkr.rexx without this library - sorry!';
    exit 10;
    end;
  end;

prtnme = 'IM_Port'; /* assume Image Professional */

  /*
   * This code attempts to read a file called "picmdpath" from REXX:
   * If it can't find it, the script will assume that the commands
   * associated with this PI Module are in "c:". If the file exists,
   * the script will look in the path that is specified in the file.
   * If you create this file, you MUST put a complete, correct path
   * in it; if the commands are in a sub-directory, you have to put
   * the trailing slash on the path (like, device:dir/).
   *
   */
  cmdpath = 'c:';
  if open(fhandle,'rexx:picmdpath','read') then  /* open the file */
    do
      cmdpath = readln(fhandle);
      call close(fhandle);  /* close the file    */
    end

options;
address;

if fullname = "" then do
  prevpath = 'ram:'; /* put user in ram to start with... */

  if show('C',nbkpath) = 1 then do
    prevpath = getclip(nbkpath);
    end;

  address(prtnme);
  options results;
  'current';
  bufdata = result; /* get name of buffer, if there is one */
  parse var bufdata bname ',' bnum ',' bx ',' by ',' btot ',' bmem ',' bparname ',' bparnum;
  if bname ~= '<none>' then do
    bufname = bname;
    end;
  if (length(bufname) > 3) then do
    epos = pos('.pg',bufname,length(bufname)-3);
    if epos ~= 0 then do
      bufname = left(bufname,epos-1)
      end
    end;
  'filerequest "'||prevpath||'","'||bufname||'",".pg","Load NBOOK"';
  nbkfile = result;
  options;

  if nbkfile = 'FR_CANCELLED' then do
    address(prtnme);
    'imtofront';
    'finish';
    exit 0;
    end;

  nbkfile = expandfilename(nbkfile);
  thispath = gimmepath(nbkfile);
  call setclip(nbkpath,thispath);
end;
else do
  nbkfile = fullname;
  thispath = gimmepath(nbkfile);
end;

  address command cmdpath||'nbkrd c "'||nbkfile||'"';
  if rc ~= 0 then do
    address(prtnme);
    'message "Cannot read '||nbkfile||'"';
    'finish';
    exit 0; /* this is not a proper nbk file */
    end;

  call open(fhandle,'ram:IP_LDTRG.tmp','read');      /* open the file */
  rstring = readln(fhandle);
  call close(fhandle);                     /* close the file    */

  address command 'c:delete >nil: ram:IP_LDTRG.tmp';

  parse var rstring width '/' height

  if height < 0 then do
    'message "Bad Height: '||height||'"';
    'finish';
    exit 0;
    end;

  if height > 32767 then do
    'message "Bad Height: '||height||'"';
    'finish';
    exit 0;
    end;

  if width < 0 then do
    'message "Bad Width: '||width||'"';
    'finish';
    exit 0;
    end;

  if width > 32767 then do
    'message "Bad Width: '||width||'"';
    'finish';
    exit 0;
    end;

  address(prtnme);

  'imtofront'; /* show user the IM screen */
  'newtargetted '||width||' '||height||' "'||gxname||'"'
  if rc ~= 0 then do
    options;
    "message Can't allocate buffer, error #"||rc;
    'autoredraw 1';
    'finish';
    exit 0;
    end
  bnum = result;

  address(prtnme);
  options results;
  'backin '||bnum;
  jackadr = result;
  options;

  'wbtofront';
  'lockimage '||bnum;
  address command cmdpath||'nbkrd d'||jackadr||' "'||nbkfile||'"';
  'unlockimage '||bnum;

  address(prtnme);
  'imtofront';
  'autoredraw 1';
  'finish';
  address;

  exit 0;

/*
 * gimmepath
 *
 * This takes the provided argument and sucks the path out of it, then
 * returns that path to the caller, sans file name.
 */
gimmepath:
  arg fullnamegx;
    tempgx = reverse(fullnamegx);
    lengx = length(fullnamegx);   /* get length of string */
    slashdex = index(tempgx,'/'); /* first occurance of '/' from right */
    colondex = index(tempgx,':');  /* first occurance of ':' from right */
    seploc = 0; /* assumes current dir, no path supplied */
    if slashdex ~= 0 then do /* we assume we are in a DIR */
      seploc = (lengx - slashdex)+1;
      end;
    else do
      if colondex ~= 0 then do /* we assume we are on a device */
        seploc = (lengx - colondex)+1;
        end;
      end;
  gxname = substr(fullnamegx,seploc+1); /* if you ever need it */
  gxpath = left(fullnamegx,seploc);
  return(gxpath);

/*
 * Since this script can't be expected to know where the CD of the user
 * is when this cmd is invoked, we have to check the path the user
 * provides - if it's not specified right from a root, then we have
 * to make it a complete specification from the root.
 */
expandfilename:
  parse arg jfile;
  if index(jfile,':') = 0 then do
    curdir = pragma(D);
    if right(curdir,1) ~= ':' then do
      if right(curdir,1) ~= '/' then do
        if curdir ~= '' then do
          curdir = curdir || '/';
          end;
        end;
      end;
    jfile = curdir||jfile;
    end;
  return(jfile);

rvalue:
  wordnum = c2d(readch(fhandle,1)) * 256;
  wordnum = wordnum + c2d(readch(fhandle,1));
  return wordnum;